perm filename PASS3.SAI[AL,HE]3 blob
sn#314209 filedate 1977-11-03 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00018 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 IFCR ¬DECLARATION(EXTENDED_COMPILATION)
C00005 00003 ! Declarations, overall description
C00008 00004 ! EMITOFFSET, EMITSMLBLK
C00011 00005 ! EMITEXPR: ONEARG, TWOARGS, THREEARGS
C00015 00006 ! EMITEXPR: variable, constant, specval
C00022 00007 ! EMITEXPR: expression
C00028 00008 ! EMITBOOL
C00030 00009 ! TSCAN: STMNT, VARIABLE, PROG
C00033 00010 ! TSCAN: BLOCK
C00048 00011 ! TSCAN: COBLOCK
C00051 00012 ! TSCAN: FORR, WHIL, IFF, PAUSE, ABORT
C00057 00013 ! TSCAN: ASSIGNMENT, PRNT, GASSIGN, ALSODO
C00061 00014 ! TSCAN: CMON, CMABLE
C00063 00015 ! TSCAN: MOVE$, CENTER, STOP, COMMENT, AFFIX, UNFIX
C00074 00016 ! TSCAN: EVDO, SPECVAL
C00075 00017 ! NULL, UNRECOGNIZED, Matching ENDs
C00076 00018 ! Bugs
C00077 ENDMK
C⊗;
IFCR ¬DECLARATION(EXTENDED_COMPILATION)
THENC
ENTRY;
BEGIN "PASS3"
IFCR ¬DECLARATION(CREFFING) THENC DEFINE CREFFING = "FALSE"; ENDC
IFCR ¬ CREFFING THENC
COMMENT: Source file requirements;
REQUIRE "ABBREV.SAI[AL,HE]" SOURCE_FILE;
REQUIRE "RECAUX.HDR[AL,HE]" SOURCE_FILE;
REQUIRE "ARITH.HDR[AL,HE]" SOURCE_FILE ;
REQUIRE "ALREC.SAI[AL,HE]" SOURCE_FILE ;
ENDC
REDEFINE $$PRGID "[]" = ["PASS3"];
IFCR CREFFING THENC REQUIRE $$PRGID MESSAGE; ENDC
REQUIRE "EMITER.HDR[AL,HE]" SOURCE_FILE;
REQUIRE "INTDEF.SAI[AL,HE]" SOURCE_FILE;
ENDC
REQUIRE "EMITER.REL[AL,HE]" LOAD_MODULE;
! Standard emitter;
! REQUIRE "TCALC.HDR[AL,HE]" SOURCE_FILE;
EXTERNAL PROCEDURE TRJCLC(RANY MOV; RANY ITEMVAR WORLD);
EXTERNAL PROCEDURE CENTCLC(RANY MOV);
EXTERNAL PROCEDURE STOPCLC(RANY MOV);
! Declarations, overall description;
RCELL USEDVARS; ! A list of variables as they appear. Used to
generate the needed list of graph node calculators;
! The word that heads a constant gives its type. These are they:;
DEFINE SCLID = 1;
DEFINE VCTID = 2;
DEFINE TRNID = 3;
! This file contains all the routines necessary for implementing the
third pass of HAL, that is, the code generator.
The principal routine is TSCAN, which generates code for the root of
the bound parse tree and calls itself recursively for the rest. The
structures in this tree are defined in HALREC[AL,HE], page three.
TSCAN is a large IF-THEN-ELSE-IF-THEN chain which determines which of
the various possible structures is present. If it is some kind of
statement, then appropriate pseudo-code is emitted. The preparation
of this code may require that code for the evaluation of an
expression. Such code is prepared in the recursive procedure
EMITEXPR, which performs type-consistency checking (but not constant
folding, which could be done here). Code for boolean tests is
prepared by EMITBOOL.
All code emission is done through the routine EMIT, to be found in
EMITER.SAI, which takes arguments specifying what output file to use
(e.g., pseudo-code or constant area), the data to output, and whether
to treat it as an instruction, an octal constant, a label
declaration, or repeatedly to produce the rel file. ;
! EMITOFFSET, EMITSMLBLK;
INTERNAL PROCEDURE EMITOFFSET(INTEGER PC;RVAR VARBL);
BEGIN "emitoffset"
! Outputs into the file PC the offset of VARBL, making a remark;
INTEGER DUMY;
MAKE_REMARK(PC,CVIS(VARIABLE:NAME[VARBL],DUMY));
EMIT(PC,VARIABLE:OFFSET[VARBL],CONST);
END "emitoffset";
INTEGER PROCEDURE EMITSMLBLK
(INTEGER LENGTH; REFERENCE REAL FIRST_ELT; BOOLEAN REF (FALSE));
BEGIN "emitsmlblk"
! Emits a constant in the small block area. The length is
given, as is the first element, so that the whole thing can be
grabbed by location. Note that LENGTH must not be greater than
3. The label of the block is returned as the result if REF is
true, otherwise, no label is emitted.
;
OWN INTEGER ARRAY DATA [1:4]; ! maxlength + 1 long;
INTEGER ARRAY RELOC [1:4];
INTEGER J, ADDR, K;
IF LENGTH > 3
THEN BEGIN
COMERR("EMITSMLBLK cannot handle length = " & CVS(LENGTH));
LENGTH ← 3;
END;
IF REF
THEN BEGIN
DATA[1] ← GENLABEL;
RELOC[1] ← SYMDEC;
K ← 2;
END
ELSE K ← 1; ! Place for next entry in DATA, RELOC;
ADDR ← LOC(FIRST_ELT);
FOR J ← 0 STEP 1 UNTIL LENGTH-1 DO
BEGIN "stuff";
DATA[K] ← MEM[ADDR + J,INTEGER];
RELOC[K] ← FLOAT;
K ← K + 1;
END "stuff";
EMIT(SMLBLK,DATA[1],RELOC[1],K-1);
RETURN(IF REF THEN DATA[1] ELSE -1);
END "emitsmlblk";
! EMITEXPR: ONEARG, TWOARGS, THREEARGS;
INTERNAL RECURSIVE INTEGER PROCEDURE EMITEXPR (REXPR XPRESS);
! Emits code for XPRESS, the value of which is to be left at top
of stack, returns the type of the expression. FRAME_DTYPE is
never returned. It is coerced to TRANS_DTYPE;
BEGIN "emitexpr"
INTEGER RTYPE, DTYPE;
RECURSIVE PROCEDURE ONEARG(INTEGER ARG1TYPE,OPERATION,RESTYPE);
BEGIN ! Pick up one argument, evaluate;
REXPR XXX;
XXX ← XPRESS; ! because of a SAIL Bug;
MAKE_REMARK(PSDCODE,"first argument");
IF EMITEXPR(CELL:CAR[EXPRN:ARGS[XXX]]) ≠ ARG1TYPE
THEN COMERR("Wrong type of argument",XXX);
EMIT(PSDCODE,OPERATION,PSINST);
DTYPE ← RESTYPE;
END;
RECURSIVE PROCEDURE TWOARGS
(INTEGER ARG1TYPE,ARG2TYPE,OPERATION,RESTYPE);
BEGIN ! Pick up two arguments, evaluate them;
DEFINE CADR(X) = "CELL:CAR[CELL:CDR[X]]";
REXPR XXX;
XXX ← XPRESS; ! because of a SAIL Bug;
MAKE_REMARK(PSDCODE,"first argument");
IF EMITEXPR(CELL:CAR[EXPRN:ARGS[XXX]]) ≠ ARG1TYPE
THEN COMERR("Wrong type for first argument",XXX);
MAKE_REMARK(PSDCODE,"second argument");
IF EMITEXPR(CADR(EXPRN:ARGS[XXX])) ≠ ARG2TYPE
THEN COMERR("Wrong type for second argument",XXX);
EMIT(PSDCODE,OPERATION,PSINST);
DTYPE ← RESTYPE;
END;
RECURSIVE PROCEDURE THREEARGS
(INTEGER ARG1TYPE,ARG2TYPE,ARG3TYPE,OPERATION,RESTYPE);
BEGIN ! Pick up three arguments, evaluate;
DEFINE CADR(X) = "CELL:CAR[CELL:CDR[X]]";
DEFINE CADDR(X) = "CELL:CAR[CELL:CDR[CELL:CDR[X]]]";
REXPR XXX;
XXX ← XPRESS; ! because of a SAIL Bug;
MAKE_REMARK(PSDCODE,"first argument");
IF EMITEXPR(CELL:CAR[EXPRN:ARGS[XXX]]) ≠ ARG1TYPE
THEN COMERR("Wrong type for first argument",XXX);
MAKE_REMARK(PSDCODE,"second argument");
IF EMITEXPR(CADR(EXPRN:ARGS[XXX])) ≠ ARG2TYPE
THEN COMERR("Wrong type for second argument",XXX);
MAKE_REMARK(PSDCODE,"third argument");
IF EMITEXPR(CADDR(EXPRN:ARGS[XXX])) ≠ ARG3TYPE
THEN COMERR("Wrong type for third argument",XXX);
EMIT(PSDCODE,OPERATION,PSINST);
DTYPE ← RESTYPE;
END;
! EMITEXPR: variable, constant, specval;
PRELOAD_WITH PUSH_PSOP, DUMMY;
OWN INTEGER ARRAY DATA[0:1];
PRELOAD_WITH PSINST, SYMREF;
OWN INTEGER ARRAY RELOC [0:1];
! To emit constants but once a list of already emitted constants is kept;
RECORD_CLASS CONLST(RPTR(SVAL,V3ECT,ROTN,TRANS) VAL; INTEGER LAB;
RPTR(CONLST) NEXT);
OWN RPTR(CONLST) SVAL_HDR,V3ECT_HDR,ROTN_HDR,TRANS_HDR;
RPTR(CONLST) PTR;
INTEGER LAB;
RTYPE ← RECTYPE(XPRESS);
! A variable?;
IF RTYPE = LOC(VARIABLE)
THEN BEGIN "variable"
EMIT(PSDCODE,GTVAL_PSOP,PSINST);
EMITOFFSET(PSDCODE,XPRESS);
DTYPE ← VARIABLE:DATATYPE[XPRESS];
USEDVARS ← CONS(XPRESS,USEDVARS);
END "variable"
! A constant?;
ELSE IF RTYPE = LOC(SVAL)
THEN BEGIN "scalar"
PTR ← SVAL_HDR; ! Check if it's already been emitted;
WHILE PTR ≠ RNULL DO
IF SVAL:VAL[XPRESS] = SVAL:VAL[CONLST:VAL[PTR]] THEN DONE
ELSE PTR ← CONLST:NEXT[PTR];
IF PTR = RNULL THEN
BEGIN ! Emit the scalar & add it to the conlst;
EMIT(SMLBLK,SCLID,CONST); ! Header for typing;
LAB ← EMITSMLBLK(1,SVAL:VAL[XPRESS],TRUE);
PTR ← NEW_RECORD(CONLST);
CONLST:VAL[PTR] ← XPRESS;
CONLST:LAB[PTR] ← LAB;
CONLST:NEXT[PTR] ← SVAL_HDR;
SVAL_HDR ← PTR;
END
ELSE LAB ← CONLST:LAB[PTR];
DATA[1] ← LAB;
EMIT(PSDCODE,DATA[0],RELOC[0],2);
DTYPE ← SVAL_DTYPE;
END "scalar"
ELSE IF RTYPE = LOC(V3ECT)
THEN BEGIN "vector"
PTR ← V3ECT_HDR; ! Check if it's already been emitted;
WHILE PTR ≠ RNULL DO
IF V3CMP(XPRESS,CONLST:VAL[PTR]) THEN PTR ← CONLST:NEXT[PTR]
ELSE DONE;
IF PTR = RNULL THEN
BEGIN ! Emit the vector & add it to the conlst;
EMIT(SMLBLK,VCTID,CONST); ! Header for typing;
LAB ← EMITSMLBLK(3,V3ECT:X[XPRESS],TRUE);
EMITSMLBLK(1,1.0); ! This puts the scale factor in;
PTR ← NEW_RECORD(CONLST);
CONLST:VAL[PTR] ← XPRESS;
CONLST:LAB[PTR] ← LAB;
CONLST:NEXT[PTR] ← V3ECT_HDR;
V3ECT_HDR ← PTR;
END
ELSE LAB ← CONLST:LAB[PTR];
DATA[1] ← LAB;
EMIT(PSDCODE,DATA[0],RELOC[0],2);
DTYPE ← V3ECT_DTYPE;
END "vector"
ELSE IF RTYPE = LOC(ROTN)
THEN BEGIN "rot" ! Will output the equivalent trans;
PTR ← ROTN_HDR; ! Check if it's already been emitted;
WHILE PTR ≠ RNULL DO
IF ROTCMP(XPRESS,CONLST:VAL[PTR]) THEN PTR ← CONLST:NEXT[PTR]
ELSE DONE;
IF PTR = RNULL THEN
BEGIN ! Emit the rotn & add it to the conlst;
EMIT(SMLBLK,TRNID,CONST); ! Header for typing;
LAB ← EMITSMLBLK(3,ROTN:RMX[XPRESS][1,1],TRUE);
EMITSMLBLK(3,ROTN:RMX[XPRESS][2,1]);
EMITSMLBLK(3,ROTN:RMX[XPRESS][3,1]);
EMITSMLBLK(3,V3ECT:X[NILVECT]); ! The fourth column;
PTR ← NEW_RECORD(CONLST);
CONLST:VAL[PTR] ← XPRESS;
CONLST:LAB[PTR] ← LAB;
CONLST:NEXT[PTR] ← ROTN_HDR;
ROTN_HDR ← PTR;
END
ELSE LAB ← CONLST:LAB[PTR];
DATA[1] ← LAB;
EMIT(PSDCODE,DATA[0],RELOC[0],2);
DTYPE ← ROTN_DTYPE;
END "rot"
ELSE IF RTYPE = LOC(TRANS)
THEN BEGIN "trans"
PTR ← TRANS_HDR; ! Check if it's already been emitted;
WHILE PTR ≠ RNULL DO
IF TRANSCMP(XPRESS,CONLST:VAL[PTR]) THEN PTR ← CONLST:NEXT[PTR]
ELSE DONE;
IF PTR = RNULL THEN
BEGIN ! Emit the trans & add it to the conlst;
EMIT(SMLBLK,TRNID,CONST); ! Header for typing;
LAB ← EMITSMLBLK(3,ROTN:RMX[TRANS:R[XPRESS]][1,1],TRUE);
EMITSMLBLK(3,ROTN:RMX[TRANS:R[XPRESS]][2,1]);
EMITSMLBLK(3,ROTN:RMX[TRANS:R[XPRESS]][3,1]);
EMITSMLBLK(3,V3ECT:X[TRANS:P[XPRESS]]); ! The fourth column;
PTR ← NEW_RECORD(CONLST);
CONLST:VAL[PTR] ← XPRESS;
CONLST:LAB[PTR] ← LAB;
CONLST:NEXT[PTR] ← TRANS_HDR;
TRANS_HDR ← PTR;
END
ELSE LAB ← CONLST:LAB[PTR];
DATA[1] ← LAB;
EMIT(PSDCODE,DATA[0],RELOC[0],2);
DTYPE ← TRANS_DTYPE;
END "trans"
ELSE IF RTYPE = LOC(FRAME)
THEN BEGIN "frame" ! Recursive call to pick up the trans inside;
EMITEXPR(FRAME:VAL[XPRESS]);
DTYPE ← FRAME_DTYPE;
END "frame"
! A specval?;
ELSE IF RTYPE = LOC(SPECVAL)
THEN BEGIN "specval"
IF SPECVAL:OLD[XPRESS]
THEN EMIT(PSDCODE,GTOLD_PSOP,PSINST)
ELSE EMIT(PSDCODE,GTNEW_PSOP,PSINST);
DTYPE ← SPECVAL:TYPE[XPRESS];
END "specval"
! EMITEXPR: expression;
! An expression?;
ELSE IF RTYPE = LOC(EXPRN)
THEN BEGIN "recurse"
INTEGER OPR;
OPR ← EXPRN:OP[XPRESS];
IF OPR < 0 ∨ OPR ≥ LAST_OP
THEN BEGIN
COMERR("Illegal expression",XPRESS);
DTYPE ← 0;
END
ELSE CASE OPR OF
BEGIN "case"
[NO_OP]
DTYPE ← EMITEXPR(CELL:CAR[EXPRN:ARGS[XPRESS]]);
[SADD_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SADD_PSOP,SVAL_DTYPE);
[SNEG_OP]
ONEARG(SVAL_DTYPE,SNEG_PSOP,SVAL_DTYPE);
[SSUB_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SSUB_PSOP,SVAL_DTYPE);
[SMUL_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SMUL_PSOP,SVAL_DTYPE);
[SDIV_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SDIV_PSOP,SVAL_DTYPE);
[SLT_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SLT_PSOP,SVAL_DTYPE);
[SEQ_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SEQ_PSOP,SVAL_DTYPE);
[SLE_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SLE_PSOP,SVAL_DTYPE);
[SGE_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SGE_PSOP,SVAL_DTYPE);
[SNE_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SNE_PSOP,SVAL_DTYPE);
[SGT_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,SGT_PSOP,SVAL_DTYPE);
[AND_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,AND_PSOP,SVAL_DTYPE);
[OR_OP]
TWOARGS(SVAL_DTYPE,SVAL_DTYPE,LOR_PSOP,SVAL_DTYPE);
[NOT_OP]
ONEARG(SVAL_DTYPE,NOT_PSOP,SVAL_DTYPE);
[VMAGN_OP]
ONEARG(V3ECT_DTYPE,VMAGN_PSOP,SVAL_DTYPE);
[VDOT_OP]
TWOARGS(V3ECT_DTYPE,V3ECT_DTYPE,VDOT_PSOP,SVAL_DTYPE);
[RMAGN_OP]
ONEARG(ROTN_DTYPE,TMAGN_PSOP,SVAL_DTYPE);
[AXIS_OP]
ONEARG(ROTN_DTYPE,TAXIS_PSOP,V3ECT_DTYPE);
[VMAKE_OP]
THREEARGS(SVAL_DTYPE,SVAL_DTYPE,SVAL_DTYPE,VMAKE_PSOP,V3ECT_DTYPE);
[SVMUL_OP]
TWOARGS(SVAL_DTYPE,V3ECT_DTYPE,SVMUL_PSOP,V3ECT_DTYPE);
[VADD_OP]
TWOARGS(V3ECT_DTYPE,V3ECT_DTYPE,VADD_PSOP,V3ECT_DTYPE);
[VSUB_OP]
TWOARGS(V3ECT_DTYPE,V3ECT_DTYPE,VSUB_PSOP,V3ECT_DTYPE);
[RVMUL_OP]
TWOARGS(ROTN_DTYPE,V3ECT_DTYPE,TVMUL_PSOP,V3ECT_DTYPE);
[TVMUL_OP]
TWOARGS(TRANS_DTYPE,V3ECT_DTYPE,TVMUL_PSOP,V3ECT_DTYPE);
[UVECT_OP]
ONEARG(V3ECT_DTYPE,UNITV_PSOP,V3ECT_DTYPE);
[POS_OP]
ONEARG(TRANS_DTYPE,TPOS_PSOP,V3ECT_DTYPE);
[ORIENT_OP]
ONEARG(TRANS_DTYPE,TORIEN_PSOP,ROTN_DTYPE);
[AXW_ROTN_OP]
TWOARGS(V3ECT_DTYPE,SVAL_DTYPE,VSAXWR_PSOP,ROTN_DTYPE);
[TMAKE_OP]
TWOARGS(ROTN_DTYPE,V3ECT_DTYPE,TMAKE_PSOP,TRANS_DTYPE);
[TVADD_OP]
TWOARGS(TRANS_DTYPE,V3ECT_DTYPE,TVADD_PSOP,TRANS_DTYPE);
[TVSUB_OP]
TWOARGS(TRANS_DTYPE,V3ECT_DTYPE,TVSUB_PSOP,TRANS_DTYPE);
[RRMUL_OP]
TWOARGS(ROTN_DTYPE,ROTN_DTYPE,TTMUL_PSOP,ROTN_DTYPE);
[TTMUL_OP]
TWOARGS(TRANS_DTYPE,TRANS_DTYPE,TTMUL_PSOP,TRANS_DTYPE);
[TINVRT_OP]
ONEARG(TRANS_DTYPE,TINVRT_PSOP,TRANS_DTYPE);
[FTOF_OP]
BEGIN ! A→B ≡ INV(A)*B;
ONEARG(TRANS_DTYPE,TINVRT_PSOP,TRANS_DTYPE);
IF EMITEXPR(CELL:CAR[CELL:CDR[EXPRN:ARGS[XPRESS]]]) ≠ TRANS_DTYPE
THEN COMERR("Wrong type for second argument",XPRESS);
EMIT(PSDCODE,TTMUL_PSOP,PSINST);
END;
[DEPR_OP]
DTYPE ← EMITEXPR(CELL:CAR[CELL:CDR[EXPRN:ARGS[XPRESS]]]);
[FMAKE_OP]
TWOARGS(ROTN_DTYPE,V3ECT_DTYPE,TMAKE_PSOP,TRANS_DTYPE);
[INVALID_OP]
COMERR("Invalid operator",XPRESS)
END "case";
IF DTYPE ≠ EXPRN:DATATYPE[XPRESS] ∧
( DTYPE ≠ TRANS_DTYPE ∨ EXPRN:DATATYPE[XPRESS] ≠ FRAME_DTYPE )
THEN COMERR("Type consistency error in EMITEXPR: " & CVS(DTYPE) &" ≠ " &
CVS(EXPRN:DATATYPE[XPRESS]) & ".",XPRESS);
END "recurse"
ELSE BEGIN
COMERR("Garbage expression",XPRESS);
DTYPE ← 0;
END;
IF DTYPE = FRAME_DTYPE THEN DTYPE ← TRANS_DTYPE;
RETURN(DTYPE);
END "emitexpr";
! EMITBOOL;
PROCEDURE EMITBOOL(REXPR CONDITION; INTEGER DESTTRUE (0), DESTFALSE (0));
BEGIN "emitbool"
! Generates code to evaluate the condition. If it succeeds,
there should be a jump to DESTTRUE, if false, to DESTFALSE. If
either is 0, instead of jumping there, fall through;
! modified by arg 9-14-76;
IF DESTFALSE
THEN BEGIN "fjump"
! Put the tested result on the stack;
IF EMITEXPR(CONDITION) ≠ SVAL_DTYPE
THEN COMERR("Non-scalar boolean",CONDITION);
EMIT(PSDCODE,JUMPC_PSOP,PSINST,1); ! JUMPC;
EMIT(PSDCODE,DESTFALSE,SYMREF,1); ! (ref) DESTFALSE;
IF DESTTRUE
THEN BEGIN "tfjump"
EMIT(PSDCODE,JUMP_PSOP,PSINST,1); ! JUMP;
EMIT(PSDCODE,DESTTRUE,SYMREF,1); ! (ref) DESTTRUE;
END "tfjump"
END "fjump"
ELSE IF DESTTRUE
THEN BEGIN "tjump"
! Put the tested result on the stack;
IF EMITEXPR(CONDITION) ≠ SVAL_DTYPE
THEN COMERR("Non-scalar boolean",CONDITION);
EMIT(PSDCODE,NOT_PSOP,PSINST,1); ! Take the complement of the boolean;
EMIT(PSDCODE,JUMPC_PSOP,PSINST,1); ! JUMPC;
EMIT(PSDCODE,DESTTRUE,SYMREF,1); ! (ref) DESTTRUE;
END "tjump";
END "emitbool";
! TSCAN: STMNT, VARIABLE, PROG;
INTEGER OFS; ! The current offset for variables;
INITIALIZE (OFS ← '34);
INTERNAL RECURSIVE PROCEDURE TSCAN (RANY PARSETREE);
BEGIN "tscan"
! TSCAN takes a parse tree and interprets its nodes, calling
appropriate routines to prepare code for each node;
INTEGER STYP, ! Statement type;
LAB1, LAB2, LAB3, LAB4;
! Save labels across recursive calls. Cannot
save in DATA since that is an OWN array;
RPTR(STMNT) STATEMENT;
LABEL MIDLABEL, ENDLABEL; ! This is to prevent parse stack overflow;
STYP ← RECTYPE(PARSETREE);
IF STYP = LOC(STMNT) THEN
BEGIN "stmnt"
! Eventually will want to output labelling information here;
STATEMENT ← PARSETREE;
PARSETREE ← STMNT:SEMANTICS[PARSETREE];
IF PARSETREE = RNULL THEN RETURN;
STYP ← RECTYPE(PARSETREE);
END "stmnt";
IF STYP = LOC(VARIABLE) ∨ STYP = LOC(DBD) ∨ STYP = LOC(PVL)
∨ STYP = LOC(NW) ∨ STYP = LOC(NOTE1) THEN
! Just ignore it. Variable declarations are treated with
block entry and exit. Others handled only during world modelling;
ELSE IF STYP = LOC(NOTE) THEN
PRINT(∂(STCONST:VAL[NOTE:HESAYS[PARSETREE]]),CRLF)
ELSE IF STYP = LOC(NOTE2) THEN
PRINT(∂(STCONST:VAL[NOTE2:HESAYS[PARSETREE]]),CRLF)
ELSE IF STYP = LOC(PROG) THEN
BEGIN "prog"
MAKE_REMARK(PSDCODE,"Start of program");
EMIT(PSDCODE,PROG_PSOP,PSINST); ! Make mechanism variables;
TSCAN(PROG:CODE[PARSETREE]);
EMIT(PSDCODE,ENDP_PSOP,PSINST); ! Clean up mechanism variables;
MAKE_REMARK(PSDCODE,"End of program");
CLOSEOUT; ! Closes the output file;
END "prog"
! TSCAN: BLOCK;
ELSE IF STYP = LOC(BLOCK) THEN
BEGIN "block"
RCELL C; ! Holds variable list and current tail of block;
INTEGER DUMY, COFS, SAVOFS; ! Holds OFS for the duration;
RVAR VARBL; ! Temporary: variable under consideration;
MAKE_REMARK(PSDCODE,"BLOCK");
SAVOFS ← OFS; ! We will assign new offsets in this block.
! Declare non-global variables;
C ← BLOCK:VARS[PARSETREE];
IF C ≠ RNULL
THEN EMIT(PSDCODE,MVAR_PSOP,PSINST); ! variable declaration;
WHILE C ≠ RNULL DO
BEGIN "vardec"
VARBL ← LLOP(C);
IF ¬GLBAL_ON(VARIABLE:ATTRIBUTES[VARBL])
THEN BEGIN ! List each non-global variable;
VARIABLE:OFFSET[VARBL] ← OFS ← OFS+2;
EMITOFFSET(PSDCODE,VARBL);
EMITOFFSET(SYMFIL,VARBL);
END;
END "vardec";
IF BLOCK:VARS[PARSETREE] ≠ RNULL
THEN EMIT(PSDCODE,0,CONST); ! zero at end of variable list;
! Link global variables;
C ← BLOCK:VARS[PARSETREE];
WHILE C ≠ RNULL DO
BEGIN "glbdec"
VARBL ← LLOP(C);
IF GLBAL_ON(VARIABLE:ATTRIBUTES[VARBL])
THEN BEGIN ! List each global variable;
INTEGER R50; ! Holds the radix 50 of the name;
INTEGER TEMP;
EMIT(PSDCODE,GLBLNK_PSOP,PSINST);
VARIABLE:OFFSET[VARBL] ← OFS ← OFS+2;
EMITOFFSET(PSDCODE,VARBL);
EMITOFFSET(SYMFIL,VARBL);
R50 ← CVSIX(CVIS(VARIABLE:NAME[VARBL],DUMY));
TEMP ← R50 LAND '177777; ! First part of name;
EMIT(PSDCODE,TEMP,CONST);
TEMP ← (R50 LSH -16) LAND '177777; ! Second part of name;
EMIT(PSDCODE,TEMP,CONST);
END;
END "glbdec";
! Declare each event;
C ← BLOCK:EVTS[PARSETREE];
IF C ≠ RNULL
THEN EMIT(PSDCODE,MAKEVT_PSOP,PSINST);
WHILE C ≠ RNULL DO
BEGIN ! List each event;
VARBL ← LLOP(C);
VARIABLE:OFFSET[VARBL] ← OFS ← OFS+2;
EMITOFFSET(PSDCODE,VARBL);
EMITOFFSET(SYMFIL,VARBL);
END;
IF BLOCK:EVTS[PARSETREE] ≠ RNULL
THEN EMIT(PSDCODE,0,CONST); ! zero at end of event list;
! Form each condition monitor;
C ← BLOCK:CMONS[PARSETREE];
WHILE C ≠ RNULL DO ! Assign an offset to each cmon;
BEGIN
RPTR(CMON) MONITOR;
MONITOR ← LLOP(C);
CMON:OFFSET[MONITOR] ← OFS ← OFS+2;
END;
COFS ← OFS;
C ← BLOCK:CMONS[PARSETREE]; ! Emit code for each cmon;
WHILE C ≠ RNULL DO
BEGIN "blkcmon"
INTEGER CTYPE,BITS;
RANY F;
DEFINE EV_CM = 0; ! event;
DEFINE EXP_CM = 1; ! expression or variable;
DEFINE DUR_CM = 2; ! duration;
DEFINE FORCE_CM = 3; ! force sensing;
DEFINE HARDW_CM = 4; ! hardware monitoring;
RPTR(CMON) MONITOR;
MONITOR ← LLOP(C);
OFS ← (COFS LAND '17400) + '410;! Move to next lexical level, offset 10;
! Here's what the various types of condition monitors look like:
for all: JUMP_PSOP LAB1 (ref), (dec) LAB2: "condition monitor checker"
for events: CMSKED, <time: 0>, CMTRIG
for variables & expressions: CMSKED, <time: 100>,
<code for boolean condition>, JUMPC LAB2, CMTRIG,
for durations: <code to get time to wait>, CMDUR,
for force sensing: {<<code to get force vect>,VMKFRC> or <code to get
force frame>, TMKFRC, <arm & coordinate bits>}
<code to get force value>,CMFORCE,
for hardware monitoring: CMSENSE,
for everyone: <code for conclusion>,
for events and variables & expressions: JUMP (ref) LAB2,
for the rest: CMDONE,
for everyone: "create condition monitor", (dec) LAB1: CMMAK <offset>,
<type>, (ref) LAB2,
for events: <event to wait for>,
for force sensing and hardware monitoring: <bits>;
CTYPE ← IF RECTYPE(CMON:CONDITION[MONITOR]) = LOC(VARIABLE) ∧
VARIABLE:DATATYPE[CMON:CONDITION[MONITOR]] = EVENT_DTYPE THEN EV_CM
ELSE IF RECTYPE(CMON:CONDITION[MONITOR]) = LOC(VARIABLE) ∨
RECTYPE(CMON:CONDITION[MONITOR]) = LOC(EXPRN) THEN EXP_CM
ELSE IF RECTYPE(CMON:CONDITION[MONITOR]) = LOC(DURATION) THEN DUR_CM
ELSE IF RECTYPE(CMON:CONDITION[MONITOR]) = LOC(FORCE) THEN FORCE_CM
ELSE HARDW_CM;
EMIT(PSDCODE,JUMP_PSOP,PSINST); ! Jump to declaration;
LAB1 ← GENLABEL; ! Declaration;
EMIT(PSDCODE,LAB1,SYMREF);
MAKE_REMARK(PSDCODE,"Condition monitor checker");
LAB2 ← GENLABEL; ! start address;
EMIT(PSDCODE,LAB2,SYMDEC);
CASE CTYPE OF BEGIN "c-m checker"
[EV_CM] BEGIN "cmevt" ! An event to wait for;
EMIT(PSDCODE,CMSKED_PSOP,PSINST);
EMIT(PSDCODE,CMTRIG_PSOP,PSINST);
END "cmevt";
[EXP_CM] BEGIN "cmexpr" ! An expression to be evaluated;
EMIT(PSDCODE,CMSKED_PSOP,PSINST);
EMIT(PSDCODE,100,CONST); ! Waiting interval;
EMITBOOL(CMON:CONDITION[MONITOR],0,LAB2);
EMIT(PSDCODE,CMTRIG_PSOP,PSINST);
END "cmexpr";
[DUR_CM] BEGIN "cmdur" ! A duration to wait for;
EMITEXPR(DURATION:TIME[CMON:CONDITION[MONITOR]]); ! Get the time;
EMIT(PSDCODE,CMDUR_PSOP,PSINST);
END "cmdur";
[FORCE_CM] BEGIN "cmforce" ! A force to wait for;
F ← CMON:CONDITION[MONITOR];
IF FORCE:DIRECT[F] ≠ XHAT ∧ FORCE:DIRECT[F] ≠ YHAT
∧ FORCE:DIRECT[F]≠ZHAT THEN
BEGIN ! Need to make force frame;
EMITEXPR(FORCE:DIRECT[F]); ! Get force vector;
EMIT(PSDCODE,VMKFRC_PSOP,PSINST); ! Make up force frame;
EMIT(PSDCODE,TFRCST_PSOP,PSINST); ! Set it up;
DUMY ← FTABLE +
(IF W_ARM_ON(CMON:FLAGS[MONITOR]) THEN YELARM ELSE BLUARM);
EMIT(PSDCODE,DUMY,CONST); ! Bits for SETC;
END
ELSE IF FORCE:F_F[F] ≠ RNULL THEN
BEGIN ! Need to set up force frame;
EMITEXPR(F_FRAME:FRAME[FORCE:F_F[F]]); ! Get force frame;
EMIT(PSDCODE,TFRCST_PSOP,PSINST); ! Set it up;
EMIT(PSDCODE,F_FRAME:C_SYS[FORCE:F_F[F]],CONST); ! Bits for SETC;
END;
EMITEXPR(FORCE:VAL[CMON:CONDITION[MONITOR]]); ! Get force value;
EMIT(PSDCODE,CMFORCE_PSOP,PSINST);
END "cmforce";
[HARDW_CM] EMIT(PSDCODE,CMSENSE_PSOP,PSINST)
END "c-m checker";
TSCAN(CMON:CONCLUSION[MONITOR]);
IF CTYPE = EV_CM ∨ CTYPE = EXP_CM THEN
BEGIN
EMIT(PSDCODE,JUMP_PSOP,PSINST);
EMIT(PSDCODE,LAB2,SYMREF)
END
ELSE EMIT(PSDCODE,CMDONE_PSOP,PSINST);
MAKE_REMARK(PSDCODE,"Create condition monitor");
EMIT(PSDCODE,LAB1,SYMDEC);
EMIT(PSDCODE,CMMAK_PSOP,PSINST);
EMIT(PSDCODE,CMON:OFFSET[MONITOR],CONST);
EMIT(PSDCODE,CTYPE,CONST); ! Tell what type of cmon it is;
EMIT(PSDCODE,LAB2,SYMREF); ! Tell where the cmon starts;
IF CTYPE = EV_CM THEN ! Which event to wait for;
EMITOFFSET(PSDCODE,CMON:CONDITION[MONITOR])
ELSE IF CTYPE = FORCE_CM THEN ! What frcsig needs to know;
BEGIN ! Figure out the bits;
BITS ← FORCE:REL[F] + (IF FORCE:DIRECT[F] = ZHAT THEN ZFORCE ELSE
IF FORCE:DIRECT[F] = YHAT THEN YFORCE ELSE XFORCE);
IF ¬FORCE:TYPE[F] THEN BITS ← BITS + XMOMENT; ! It's a torque;
BITS ← BITS +
(IF W_ARM_ON(CMON:FLAGS[MONITOR]) THEN YELARM ELSE BLUARM);
EMIT(PSDCODE,BITS,CONST);
END
! ELSE IF CTYPE = HARDW_CM THEN who knows what we need to do;
END "blkcmon";
OFS ← COFS; ! Restore lexical level;
! Form the calculators local to this block;
C ← BLOCK:CLCS[PARSETREE];
WHILE C ≠ RNULL DO
BEGIN "blkclc"
RVAR ITEMVAR NEED;
RPTR(CALCULATOR) CALC;
CALC ← LLOP(C);
! MEXP_PSOP, <needed list>, <0>, SYMREF (LAB1), <offset> ;
EMIT(PSDCODE,MEXP_PSOP,PSINST);
FOREACH NEED SUCH THAT NEED IN CALCULATOR:NEEDED[CALC] DO
EMITOFFSET(PSDCODE,∂(NEED));
EMIT(PSDCODE,0,CONST);
LAB1 ← GENLABEL;
EMIT(PSDCODE,LAB1,SYMREF);
CALCULATOR:OFFSET[CALC] ← OFS ← OFS + 2;
EMIT(PSDCODE,OFS,CONST);
! JUMP_PSOP, SYMREF (LAB2), LAB1: <code for expression>,
ENDCLC_PSOP, LAB2: ;
EMIT(PSDCODE,JUMP_PSOP,PSINST);
LAB2 ← GENLABEL;
EMIT(PSDCODE,LAB2,SYMREF);
EMIT(PSDCODE,LAB1,SYMDEC);
EMITEXPR(CALCULATOR:FORM[CALC]);
EMIT(PSDCODE,ENDCLC_PSOP,PSINST);
EMIT(PSDCODE,LAB2,SYMDEC);
END "blkclc";
! Generate the code for the statements in the block;
C ← BLOCK:CODE[PARSETREE];
WHILE C ≠ RNULL DO
TSCAN(LLOP(C));
MAKE_REMARK(PSDCODE,"Block end cleanup");
! Get rid of condition monitors;
C ← BLOCK:CMONS[PARSETREE];
IF C ≠ RNULL
THEN EMIT(PSDCODE,CMDEST_PSOP,PSINST);
WHILE C ≠ RNULL DO
! List each monitor;
EMIT(PSDCODE,CMON:OFFSET[LLOP(C)],CONST); ! offset;
IF BLOCK:CMONS[PARSETREE] ≠ RNULL
THEN EMIT(PSDCODE,0,CONST); ! zero at end of cond. mon. list;
! Get rid of non-global variables;
C ← BLOCK:VARS[PARSETREE];
IF C ≠ RNULL
THEN EMIT(PSDCODE,KVAR_PSOP,PSINST);
WHILE C ≠ RNULL DO
BEGIN "varrem"
VARBL ← LLOP(C);
IF ¬GLBAL_ON(VARIABLE:ATTRIBUTES[VARBL])
THEN ! List each non-global variable;
EMITOFFSET(PSDCODE,VARBL);
END "varrem";
IF BLOCK:VARS[PARSETREE] ≠ RNULL
THEN EMIT(PSDCODE,0,CONST); ! zero at end of variable list;
! Get rid of events;
C ← BLOCK:EVTS[PARSETREE];
IF C ≠ RNULL
THEN EMIT(PSDCODE,DESEVT_PSOP,PSINST); ! variable removal;
WHILE C ≠ RNULL DO
! List each event;
EMITOFFSET(PSDCODE,LLOP(C));
IF BLOCK:EVTS[PARSETREE] ≠ RNULL
THEN EMIT(PSDCODE,0,CONST); ! zero at end of event list;
MAKE_REMARK(PSDCODE,"End of BLOCK");
OFS ← SAVOFS; ! Restore the offset to original state;
END "block"
! TSCAN: COBLOCK;
ELSE IF STYP = LOC(COBLOCK) THEN
BEGIN "coblock"
RCLASS COLAB (INTEGER LBEL; RPTR(COLAB) NEXT);
RPTR (COLAB) LABELS, HERE;
INTEGER SAVOFS; ! Holds OFS for the duration;
RCELL C;
PRELOAD_WITH JUMP_PSOP, DUMMY, ! 1-2;
SPROUT_PSOP, DUMMY, ! 3-4;
TERMINATE_PSOP, ! 5;
DUMMY; ! 6;
INTEGER OWN ARRAY DATA[1:6];
PRELOAD_WITH PSINST, SYMREF, ! 1-2;
PSINST, SYMREF, ! 3-4;
PSINST, ! 5;
SYMDEC; ! 6;
INTEGER OWN ARRAY RELOC[1:6];
HERE ← LABELS ← NEW_RECORD (COLAB);
LAB1 ← DATA[2] ← GENLABEL;
MAKE_REMARK(PSDCODE,"Coblock");
EMIT(PSDCODE,DATA[1],RELOC[1],2); ! Jump to end label;
SAVOFS ← OFS;
OFS ← (OFS LAND '17400) + '410; ! Move to next lexical level, offset 10;
C ← COBLOCK:CODE[PARSETREE];
WHILE C ≠ RNULL DO
BEGIN "onecob"
HERE ← COLAB:NEXT[HERE] ← NEW_RECORD(COLAB);
DATA[6] ← COLAB:LBEL[HERE] ← GENLABEL;
EMIT(PSDCODE,DATA[6],RELOC[6],1); ! symdec;
MAKE_REMARK(PSDCODE," Costatement");
TSCAN(LLOP(C));
EMIT(PSDCODE,DATA[5],RELOC[5],1); ! Terminate;
END "onecob";
OFS ← SAVOFS; ! Back to previous level;
DATA[6] ← LAB1; ! Label for jump around cocode;
EMIT(PSDCODE,DATA[6],RELOC[6],1); ! symdec;
HERE ← COLAB:NEXT[LABELS];
MAKE_REMARK(PSDCODE," epilog of Coblock");
EMIT(PSDCODE,DATA[3],RELOC[3],1); ! Sprout;
WHILE HERE ≠ RNULL DO
BEGIN
DATA[4] ← COLAB:LBEL[HERE];
EMIT(PSDCODE,DATA[4],RELOC[4],1); ! Label of code;
HERE ← COLAB:NEXT[HERE];
END;
EMIT(PSDCODE,0,CONST,1); ! Final zero;
MAKE_REMARK(PSDCODE,"DπT COBLOCK");
END "coblock"
! TSCAN: FORR, WHIL, IFF, PAUSE, ABORT;
ELSE IF STYP = LOC(FORR) THEN
BEGIN "forr"
! This is how it all should look: [FOR LOOP] <stack initial,
final, step> LAB1: XCOPY 2 (current value) XCHNGE <control
variable> XFORCHK LAB2 <body> XCOPY 0 (step size) XCOPY 3
(current value) XSADD XREPLACE 3 (current value) XJUMP LAB1
LAB2: XPOP XPOP XPOP [END FOR];
MAKE_REMARK(PSDCODE,"FOR LOOP");
EMITEXPR(FORR:INITIAL[PARSETREE]);
! This will emit code for the calculation of the initial
value;
EMITEXPR(FORR:FINAL[PARSETREE]);
! This will emit code for the calculation of the final
value;
EMITEXPR(FORR:STEP[PARSETREE]);
! This will emit code for the calculation of the step
value;
LAB1 ← GENLABEL; ! Top of loop;
LAB2 ← GENLABEL; ! End of loop;
EMIT(PSDCODE,LAB1,SYMDEC);
EMIT(PSDCODE,COPY_PSOP,PSINST);
EMIT(PSDCODE,2,CONST);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,FORR:CONVAR[PARSETREE]);
EMIT(PSDCODE,FORCHK_PSOP,PSINST);
EMIT(PSDCODE,LAB2,SYMREF);
TSCAN(FORR:BODY[PARSETREE]);
EMIT(PSDCODE,COPY_PSOP,PSINST);
EMIT(PSDCODE,0,CONST);
EMIT(PSDCODE,COPY_PSOP,PSINST);
EMIT(PSDCODE,3,CONST);
EMIT(PSDCODE,SADD_PSOP,PSINST);
EMIT(PSDCODE,REPLACE_PSOP,PSINST);
EMIT(PSDCODE,3,CONST);
EMIT(PSDCODE,JUMP_PSOP,PSINST);
EMIT(PSDCODE,LAB1,SYMREF);
EMIT(PSDCODE,LAB2,SYMDEC);
EMIT(PSDCODE,POP_PSOP,PSINST);
EMIT(PSDCODE,POP_PSOP,PSINST);
EMIT(PSDCODE,POP_PSOP,PSINST);
MAKE_REMARK(PSDCODE,"END FOR");
END "forr"
ELSE IF STYP = LOC(WHIL) THEN
BEGIN "while"
MAKE_REMARK(PSDCODE,"WHILE Loop");
LAB1 ← GENLABEL; ! Loop head;
LAB2 ← GENLABEL; ! After end;
EMIT(PSDCODE,LAB1,SYMDEC); ! (dec) LAB1: ;
EMITBOOL(WHIL:COND[PARSETREE],0,LAB2);
TSCAN(WHIL:BODY[PARSETREE]);
! JUMP (ref) LAB1, (dec) LAB2: ;
EMIT(PSDCODE,JUMP_PSOP,PSINST);
EMIT(PSDCODE,LAB1,SYMREF);
EMIT(PSDCODE,LAB2,SYMDEC);
MAKE_REMARK(PSDCODE,"END WHILE");
END "while"
ELSE IF STYP = LOC(IFF) THEN
BEGIN "iff"
MAKE_REMARK(PSDCODE,"IF");
LAB1 ← GENLABEL; ! The head of the ELSE part;
LAB2 ← GENLABEL; ! At the end of the IF;
EMITBOOL(IFF:COND[PARSETREE],0,LAB1);
MAKE_REMARK(PSDCODE,"THEN");
TSCAN(IFF:THN[PARSETREE]);
! JUMP (ref) LAB2, (dec) LAB1: ;
EMIT(PSDCODE,JUMP_PSOP,PSINST);
EMIT(PSDCODE,LAB2,SYMREF);
EMIT(PSDCODE,LAB1,SYMDEC);
IF IFF:ELS[PARSETREE] ≠ NULL
THEN BEGIN
MAKE_REMARK(PSDCODE,"ELSE");
TSCAN(IFF:ELS[PARSETREE]);
END;
EMIT(PSDCODE,LAB2,SYMDEC); ! (dec) LAB2: ;
MAKE_REMARK(PSDCODE,"FI");
END "iff"
ELSE IF STYP = LOC(PAUSE) THEN
BEGIN "pause"
MAKE_REMARK(PSDCODE,"PAUSE");
! Get the value on the stack;
EMITEXPR(PAUSE:VAL[PARSETREE]);
EMIT(PSDCODE,PAUSE_PSOP,PSINST);
END "pause"
ELSE IF STYP = LOC(ABORT) THEN
BEGIN "abort"
RCELL C;
MAKE_REMARK(PSDCODE,"ABORT");
EMIT(PSDCODE,ABORT_PSOP,PSINST);
C ← ABORT:VAL[PARSETREE]; ! Get list of print items;
IF C ≠ RNULL THEN MAKE_REMARK(PSDCODE,"Print");
WHILE C ≠ RNULL DO
BEGIN "abort print list"
IF RECTYPE(CELL:CAR[C]) = LOC(STCONST)
THEN BEGIN "prntstr"
INTEGER ADR;
ADR ← LOC(STCONST:VAL[CELL:CAR[C]]);
LAB1 ← GENLABEL;
EMIT(SMLBLK,LAB1,SYMDEC);
EMIT(SMLBLK,ADR,STRCONST);
EMIT(PSDCODE,PRINT_PSOP,PSINST);
EMIT(PSDCODE,LAB1,SYMREF);
END "prntstr"
ELSE BEGIN "prntexpr"
! Get the value on the stack;
EMITEXPR(CELL:CAR[C]);
EMIT(PSDCODE,VALPRN_PSOP,PSINST);
END "prntexpr";
C ← CELL:CDR[C];
END "abort print list";
MAKE_REMARK(PSDCODE,"DDT"); ! Control passes to DDT;
EMIT(PSDCODE,DDT_PSOP,PSINST);
END "abort"
ELSE GO TO MIDLABEL;
GO TO ENDLABEL; ! This is to avoid parse stack overflow;
! TSCAN: ASSIGNMENT, PRNT, GASSIGN, ALSODO;
MIDLABEL: ! Necessary to avoid parse stack overflow;
IF STYP = LOC(ASSIGNMENT) THEN
BEGIN "assignment"
MAKE_REMARK(PSDCODE,"Assignment");
! Get the value on the stack;
EMITEXPR(ASSIGNMENT:VAL[PARSETREE]);
! Emit "change variable to value on stack";
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,ASSIGNMENT:VAR[PARSETREE]);
END "assignment"
ELSE IF STYP = LOC(PRNT) THEN
BEGIN "prnt"
RCELL C;
MAKE_REMARK(PSDCODE,"Print");
C ← PRNT:VAL[PARSETREE]; ! Get list of print items;
WHILE C ≠ RNULL DO
BEGIN "print list"
IF RECTYPE(CELL:CAR[C]) = LOC(STCONST)
THEN BEGIN "prntstr"
INTEGER ADR;
ADR ← LOC(STCONST:VAL[CELL:CAR[C]]);
LAB1 ← GENLABEL;
EMIT(SMLBLK,LAB1,SYMDEC);
EMIT(SMLBLK,ADR,STRCONST);
EMIT(PSDCODE,PRINT_PSOP,PSINST);
EMIT(PSDCODE,LAB1,SYMREF);
END "prntstr"
ELSE BEGIN "prntexpr"
! Get the value on the stack;
EMITEXPR(CELL:CAR[C]);
EMIT(PSDCODE,VALPRN_PSOP,PSINST);
END "prntexpr";
C ← CELL:CDR[C];
END "print list"
END "prnt"
ELSE IF STYP = LOC(GASSIGN) THEN
BEGIN "gassign"
! Only handles GASSIGN:OP = 1 or 2 (is / is not computed by);
RPTR(CALCULATOR,LBLVAR) CLCV;
IF GASSIGN:OP[PARSETREE] = 1
THEN EMIT(PSDCODE,MCLC_PSOP,PSINST) ! Is calculated by;
ELSE IF GASSIGN:OP[PARSETREE] = 2
THEN EMIT(PSDCODE,DCLC_PSOP,PSINST) ! Is not calculated by;
ELSE COMERR("Illegal GASSIGN",PARSETREE);
CLCV ← GASSIGN:CLC[PARSETREE];
IF RECTYPE(CLCV) = LOC(LBLVAR)
THEN CLCV ← LBLVAR:SEMANTICS[CLCV];
EMIT(PSDCODE,CALCULATOR:OFFSET[CLCV],CONST);
EMITOFFSET(PSDCODE,GASSIGN:VAR[PARSETREE]);
END "gassign"
ELSE IF STYP = LOC(ALSODO) THEN
BEGIN "alsodo"
! MCHG_PSOP <offset> (symref LAB1) JUMP_PSOP (symref LAB2)
LAB1: <code for changer> TERMINATE_PSOP LAB2: ;
RPTR(CHANGER,LBLVAR) CHGV;
MAKE_REMARK(PSDCODE,"Also do");
LAB1 ← GENLABEL; ! Start of changer code;
LAB2 ← GENLABEL; ! End of changer code;
EMIT(PSDCODE,MCHG_PSOP,PSINST);
EMITOFFSET(PSDCODE,ALSODO:VAR[PARSETREE]);
EMIT(PSDCODE,LAB1,SYMREF);
EMIT(PSDCODE,JUMP_PSOP,PSINST);
EMIT(PSDCODE,LAB2,SYMREF);
EMIT(PSDCODE,LAB1,SYMDEC);
CHGV ← ALSODO:CHG[PARSETREE];
IF RECTYPE(CHGV) = LOC(LBLVAR)
THEN CHGV ← LBLVAR:SEMANTICS[CHGV];
TSCAN(CHANGER:CODE[CHGV]);
EMIT(PSDCODE,TERMINATE_PSOP,PSINST);
EMIT(PSDCODE,LAB2,SYMDEC);
END "alsodo"
! TSCAN: CMON, CMABLE;
ELSE IF STYP = LOC(CMON) THEN
BEGIN
IF ¬DEFER_ON(CMON:FLAGS[PARSETREE]) THEN
BEGIN "cmon"
MAKE_REMARK(PSDCODE,"Enable condition monitor");
EMIT(PSDCODE,CMENBL_PSOP,PSINST);
EMIT(PSDCODE,CMON:OFFSET[PARSETREE],CONST);
END "cmon"
END
ELSE IF STYP = LOC(CMABLE) THEN
BEGIN "cmable"
RPTR(CMON,LBLVAR) CMONV; ! The CMON;
CMONV ← CMABLE:WHAT[PARSETREE];
IF RECTYPE(CMONV) = LOC(LBLVAR)
THEN CMONV ← LBLVAR:SEMANTICS[CMONV];
IF CMABLE:FLAG[PARSETREE]
THEN BEGIN "disable"
MAKE_REMARK(PSDCODE,"Disable");
EMIT(PSDCODE,CMDSBL_PSOP,PSINST); ! CMDSBL (offset);
EMIT(PSDCODE,CMON:OFFSET[CMONV],CONST);
END "disable"
ELSE BEGIN "enable"
MAKE_REMARK(PSDCODE,"Enable");
EMIT(PSDCODE,CMENBL_PSOP,PSINST); ! CMENBL (offset);
EMIT(PSDCODE,CMON:OFFSET[CMONV],CONST);
END "enable"
END "cmable"
! TSCAN: MOVE$, CENTER, STOP, COMMENT, AFFIX, UNFIX;
ELSE IF STYP = LOC(MOVE$) THEN
BEGIN "move"
RPTR(DEXPR) DESTEXPR; ! The destiniation expression;
RPTR(ARRIVAL) ARR; ! Arrival clause (if any);
RCELL CLAUS; ! The list of clauses;
INTEGER BITS;
RANY X;
MAKE_REMARK(PSDCODE,"Move");
! Generate code for all deproaches & via points that are expressions;
CLAUS ← MOVE$:CLAUSES[PARSETREE];
WHILE CLAUS ≠ RNULL DO
BEGIN "mexpr"
RANY THISCLAUSE;
THISCLAUSE ← LLOP(CLAUS);
IF RECTYPE(THISCLAUSE) = LOC(VIA) AND
RECTYPE(DEXPR:EXPN[VIA:ACTPLACE[THISCLAUSE]]) = LOC(EXPRN)
THEN BEGIN "via"
EMITEXPR(DEXPR:EXPN[VIA:ACTPLACE[THISCLAUSE]]);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,DEXPR:VAR[VIA:ACTPLACE[THISCLAUSE]]);
END "via";
IF RECTYPE(THISCLAUSE) = LOC(DEPARTURE) AND
RECTYPE(DEXPR:EXPN[DEPARTURE:ACTPLACE[THISCLAUSE]]) = LOC(EXPRN)
THEN BEGIN "dep"
EMITEXPR(DEXPR:EXPN[DEPARTURE:ACTPLACE[THISCLAUSE]]);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,DEXPR:VAR[DEPARTURE:ACTPLACE[THISCLAUSE]]);
END "dep";
IF RECTYPE(THISCLAUSE) = LOC(ARRIVAL)
THEN BEGIN "arr"
ARR←THISCLAUSE;
IF RECTYPE(DEXPR:EXPN[ARRIVAL:ACTPLACE[THISCLAUSE]])=LOC(EXPRN) THEN
BEGIN
EMITEXPR(DEXPR:EXPN[ARRIVAL:ACTPLACE[THISCLAUSE]]);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,DEXPR:VAR[ARRIVAL:ACTPLACE[THISCLAUSE]]);
END;
END "arr";
END "mexpr";
! Generate code for the destination point, if it is an expression;
DESTEXPR ← MOVE$:DEXP[PARSETREE];
IF RECTYPE(DEXPR:EXPN[DESTEXPR]) = LOC(EXPRN)
THEN BEGIN "movdest" ! Must emit code to evaluate the
destination;
EMITEXPR(DEXPR:EXPN[DESTEXPR]);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,DEXPR:VAR[DESTEXPR]);
END "movdest";
! Set up force frame (if any);
CLAUS ← MOVE$:CLAUSES[PARSETREE];
WHILE CLAUS ≠ RNULL DO
BEGIN
X ← LLOP(CLAUS);
IF RECTYPE(X) = LOC(F_FRAME) THEN
BEGIN "f_frame"
EMITEXPR(F_FRAME:FRAME[X]); ! Get force frame;
EMIT(PSDCODE,TFRCST_PSOP,PSINST); ! Set it up;
BITS ← F_FRAME:C_SYS[X] lor
MEMLOC(IF MOVE$:CF[PARSETREE]=YARM THEN YELARM ELSE BLUARM,INTEGER);
EMIT(PSDCODE,BITS,CONST); ! Bits for arm & co¬ord sys;
! (hand or table);
DONE;
END "f_frame";
END;
! Set up all forces being applied in this MOVE;
CLAUS ← MOVE$:CLAUSES[PARSETREE];
WHILE CLAUS ≠ RNULL DO
BEGIN
X ← LLOP(CLAUS);
IF RECTYPE(X) = LOC(FORCE) THEN
BEGIN "force"
! First set up the control bits for COMPLY;
IF FORCE:DIRECT[X] = XHAT THEN BITS ← XFORCE
ELSE IF FORCE:DIRECT[X] = YHAT THEN BITS ← YFORCE
ELSE IF FORCE:DIRECT[X] = ZHAT THEN BITS ← ZFORCE
ELSE BEGIN "make force frame"
BITS ← XFORCE;
EMITEXPR(FORCE:DIRECT[X]); ! Get force vector;
EMIT(PSDCODE,VMKFRC_PSOP,PSINST); ! Make force frame;
EMIT(PSDCODE,TFRCST_PSOP,PSINST); ! Set it up;
EMIT(PSDCODE,F_FRAME:C_SYS[FORCE:F_F[X]],CONST); ! Bits for SETC;
END "make force frame";
IF ¬FORCE:TYPE[X] THEN BITS ← BITS + XMOMENT; ! It's a torque;
BITS ← BITS + (IF MOVE$:CF[PARSETREE]=YARM THEN YELARM ELSE BLUARM);
EMITEXPR(FORCE:VAL[X]); ! Get the force's magnitude;
EMIT(PSDCODE,COMPLY_PSOP,PSINST);
EMIT(PSDCODE,BITS,CONST); ! Bits for COMPLY;
END "force";
END;
! Enable any condition monitors local to this move statement;
CLAUS ← MOVE$:CLAUSES[PARSETREE];
WHILE CLAUS ≠ RNULL DO
BEGIN
X←LLOP(CLAUS);
IF RECTYPE(X)=LOC(CMON) ∧ ¬DEFER_ON(CMON:FLAGS[X]) THEN
BEGIN "cmon"
MAKE_REMARK(PSDCODE,"Enable condition monitor");
EMIT(PSDCODE,CMENBL_PSOP,PSINST);
EMIT(PSDCODE,CMON:OFFSET[X],CONST);
END "cmon"
END;
TRJCLC(PARSETREE,STMNT:IW[STATEMENT]);
! Disable any condition monitors local to this move statement;
CLAUS ← MOVE$:CLAUSES[PARSETREE];
WHILE CLAUS ≠ RNULL DO
BEGIN
X←LLOP(CLAUS);
IF RECTYPE(X)=LOC(CMON) THEN
BEGIN "cmon"
MAKE_REMARK(PSDCODE,"Disable condition monitor");
EMIT(PSDCODE,CMDSBL_PSOP,PSINST);
EMIT(PSDCODE,CMON:OFFSET[X],CONST);
END "cmon"
END;
! Update deproach variable if need be;
IF ARR≠RNULL THEN
BEGIN
IF ARRIVAL:THRU[ARR]=NILDEPROACH THEN EMITEXPR(NILDEPROACH)
ELSE EMITEXPR(DEXPR:VAR[ARRIVAL:ACTPLACE[ARR]]);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
IF MOVE$:CF[PARSETREE]=BARM THEN EMITOFFSET(PSDCODE,BDEPROACH)
ELSE EMITOFFSET(PSDCODE,YDEPROACH);
END;
END "move"
ELSE IF STYP = LOC(OPERATE) THEN
BEGIN "operate"
RPTR(MOVE$) MOV; ! Fill this in from the OPERATE record;
RPTR(DEXPR) DESTEXPR; ! The destiniation expression;
RCELL CLAUS; ! The list of clauses;
MAKE_REMARK(PSDCODE,"Operate");
IF OPERATE:WHAT[PARSETREE] ≠ BHAND AND
OPERATE:WHAT[PARSETREE] ≠ YHAND
THEN COMERR("Can't OPERATE a non-hand");
MOV ← NEW_RECORD(MOVE$);
MOVE$:WHAT[MOV] ← OPERATE:WHAT[PARSETREE];
MOVE$:DEST[MOV] ← OPERATE:DEST[PARSETREE];
MOVE$:CLAUSES[MOV] ← OPERATE:CLAUSES[PARSETREE];
MOVE$:CF[MOV] ← OPERATE:CF[PARSETREE];
MOVE$:DEXP[MOV] ← OPERATE:DEXP[PARSETREE];
! Generate code for all via points that are expressions;
CLAUS ← MOVE$:CLAUSES[MOV];
WHILE CLAUS ≠ RNULL DO
BEGIN "ovia"
RANY THISCLAUSE;
THISCLAUSE ← LLOP(CLAUS);
IF RECTYPE(THISCLAUSE) = LOC(VIA) AND
RECTYPE(DEXPR:EXPN[VIA:ACTPLACE[THISCLAUSE]]) = LOC(EXPRN)
THEN BEGIN "oprvia"
EMITEXPR(DEXPR:EXPN[VIA:ACTPLACE[THISCLAUSE]]);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,DEXPR:VAR[VIA:ACTPLACE[THISCLAUSE]]);
END "oprvia";
END "ovia";
! Generate code for the destination point, if it is an expression;
DESTEXPR ← MOVE$:DEXP[MOV];
IF RECTYPE(DEXPR:EXPN[DESTEXPR]) = LOC(EXPRN)
THEN BEGIN "oprdest" ! Must emit code to evaluate the
destination;
EMITEXPR(DEXPR:EXPN[DESTEXPR]);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,DEXPR:VAR[DESTEXPR]);
END "oprdest";
TRJCLC(MOV,STMNT:IW[STATEMENT]);
END "operate"
ELSE IF STYP = LOC(CENTER) THEN
BEGIN "center"
MAKE_REMARK(PSDCODE,"Center");
CENTCLC(PARSETREE);
END "center"
ELSE IF STYP = LOC(STOP) THEN
BEGIN "stop"
MAKE_REMARK(PSDCODE,"Stop");
STOPCLC(PARSETREE);
END "stop"
ELSE IF STYP = LOC(COMMNT) THEN
BEGIN "commnt"
END "commnt"
ELSE IF STYP = LOC(AFFIX) THEN
BEGIN "affix"
RCELL C;
MAKE_REMARK(PSDCODE,"Affixment");
C ← AFFIX:GPHCODE[PARSETREE];
WHILE C ≠ RNULL DO
BEGIN "afscan"
TSCAN(LLOP(C));
END "afscan";
MAKE_REMARK(PSDCODE,"End of affixment");
END "affix"
ELSE IF STYP = LOC(UNFIX) THEN
BEGIN "unfix"
RCELL C;
MAKE_REMARK(PSDCODE,"Unfixment");
C ← UNFIX:GPHCODE[PARSETREE];
WHILE C ≠ RNULL DO
BEGIN "afscan"
TSCAN(LLOP(C));
END "afscan";
MAKE_REMARK(PSDCODE,"End of unfixment");
END "unfix"
! TSCAN: EVDO, SPECVAL;
ELSE IF STYP = LOC(EVDO) THEN
BEGIN "evdo"
MAKE_REMARK(PSDCODE,"Event operation");
IF EVDO:OP[PARSETREE] = 0
THEN EMIT(PSDCODE,SIGNAL_PSOP,PSINST)
ELSE EMIT(PSDCODE,WAITE_PSOP,PSINST);
EMITOFFSET(PSDCODE,EVDO:VAR[PARSETREE]);
END "evdo"
ELSE IF STYP = LOC(SPECVAL) THEN
BEGIN "specval"
IF SPECVAL:OLD[PARSETREE] = TRUE
THEN EMIT(PSDCODE,GTOLD_PSOP,PSINST)
ELSE EMIT(PSDCODE,GTNEW_PSOP,PSINST);
END "specval"
! NULL, UNRECOGNIZED, Matching ENDs;
ELSE IF STYP = LOC(BLKOP) OR
STYP = LOC(ASSERT) OR
STYP = LOC(S_FAC) OR
STYP = LOC(DENY) OR
STYP = LOC(PVL) OR
STYP = LOC(NW) THEN ! No-op at the moment;
ELSE COMERR("Can't generate code for this",PARSETREE);
ENDLABEL: ! This is here to avoid parse stack overflow;
END "tscan";
END $$prgid;
! Bugs
Global events will not work.
iw=ow=any after a condition monitor
Extra variables are being generated for moves. Can they be suppressed?
;